home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
pascal
/
tptc17sc.zip
/
TPTC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-03-26
|
18KB
|
531 lines
(*
* TPTC - Turbo Pascal to C translator
*
* S.H.Smith, 9/9/85 (rev. 2/13/88)
*
* Copyright 1986, 1988 by Samuel H. Smith; All rights reserved.
*
* See HISTORY.DOC for complete revision history.
* See TODO.DOC for pending changes.
*
*)
{$T+} {Produce mapfile}
{$R-} {Range checking}
{$B-} {Boolean complete evaluation}
{$S-} {Stack checking}
{$I+} {I/O checking}
{$N-} {Numeric coprocessor}
{$V-} {Relax string rules}
{$M 65500,16384,655360} {stack, minheap, maxhep}
program translate_tp_to_c;
uses Dos;
const
version1 = 'TPTC - Translate Pascal to C';
version2 = 'Version 1.7 03/26/88 (C) 1988 S.H.Smith';
minstack = 4000; {minimum free stack space needed}
outbufsiz = 10000; {size of top level output file buffer}
inbufsiz = 2000; {size of input file buffers}
maxparam = 16; {max number of parameters to process}
maxnest = 10; {maximum procedure nesting-1}
maxincl = 2; {maximum source file nesting-1}
statrate = 5; {clock ticks between status displays}
ticks_per_second = 18.2;
const
nestfile = 'p$'; {scratchfile for nested procedures}
type
anystring = string [127];
string255 = string [255];
string80 = string [80];
string64 = string [64];
string40 = string [40];
string20 = string [20];
string10 = string [10];
(* command options *)
const
debug: boolean = false; {-B trace scan}
debug_parse: boolean = false; {-BP trace parse}
mt_plus: boolean = false; {-M true if translating Pascal/MT+}
map_lower: boolean = false; {-L true to map idents to lower case}
dumpsymbols: boolean = false; {-D dump tables to object file}
dumppredef: boolean = false; {-DP dump predefined system symbols}
includeinclude:boolean = false; {-I include include files in output}
quietmode: boolean = false; {-Q disable warnings?}
identlen: integer = 13; {-Tnn nominal length of identifiers}
workdir: string64 = ''; {-Wd: work/scratch file directory}
tshell: boolean = false; {-# pass lines starting with '#'}
pass_comments: boolean = true; {-NC no comments in output}
type
toktypes = (number, identifier,
strng, keyword,
chars, comment,
unknown);
symtypes = (s_int, s_long,
s_double, s_string,
s_char, s_struct,
s_file, s_bool,
s_void );
supertypes = (ss_scalar, ss_const,
ss_func, ss_struct,
ss_array, ss_pointer,
ss_builtin, ss_none );
symptr = ^symrec;
symrec = record
symtype: symtypes; { simple type }
suptype: supertypes; { scalar,array etc. }
id: string40; { name of entry }
repid: string40; { replacement ident }
parcount: integer; { parameter count,
>=0 -- procedure/func pars
>=1 -- array level
-1 -- simple variable
-2 -- implicit deref var }
pvar: word; { var/val reference bitmap, or
structure member nest level }
base: integer; { base value for subscripts }
limit: word; { limiting value for scalars }
next: symptr; { link to next symbol in table }
end;
paramlist = record
n: integer;
id: array [1..maxparam] of string80;
stype: array [1..maxparam] of symtypes;
sstype: array [1..maxparam] of supertypes;
end;
const
(* names of symbol types *)
typename: array[symtypes] of string40 =
('int', 'long',
'double', 'strptr',
'char', 'struct',
'file', 'boolean',
'void' );
supertypename: array[supertypes] of string40 =
('scalar', 'constant',
'function', 'structure',
'array', 'pointer',
'builtin', 'none' );
(* these words start new statements or program sections *)
nkeywords = 14;
keywords: array[1..nkeywords] of string40 = (
'PROGRAM', 'PROCEDURE', 'FUNCTION',
'VAR', 'CONST', 'TYPE',
'LABEL', 'OVERLAY', 'FORWARD',
'MODULE', 'EXTERNAL', 'CASE',
'INTERFACE', 'IMPLEMENTATION');
type
byteptr = ^byte;
var
inbuf: array [0..maxincl] of byteptr;
srcfd: array [0..maxincl] of text;
srclines: array [0..maxincl] of integer;
srcfiles: array [0..maxincl] of string64;
outbuf: array [0..maxnest] of byteptr;
ofd: array [0..maxnest] of text;
inname: string64; {source filename}
outname: string64; {output filename}
unitname: string64; {output filename without extention}
symdir: string64; {.UNS symbol search directory}
ltok: string80; {lower/upper current token}
tok: string80; {all upper case current token}
ptok: string80; {previous token}
spaces: anystring; {leading spaces on current line}
decl_prefix: anystring; {declaration identifier prefix, if any}
const
starttime: longint = 0; {time translation was started}
curtime: longint = 0; {current time}
statustime: longint = 0; {time of last status display}
nextc: char = ' ';
toktype: toktypes = unknown;
ptoktype: toktypes = unknown;
linestart: boolean = true;
extradot: boolean = false;
nospace: boolean = false;
cursym: symptr = nil;
curtype: symtypes = s_void;
cexprtype: symtypes = s_void;
cursuptype: supertypes = ss_scalar;
curlimit: integer = 0;
curbase: integer = 0;
curpars: integer = 0;
withlevel: integer = 0;
unitlevel: integer = 0;
srclevel: integer = 0;
srctotal: integer = 1;
objtotal: integer = 0;
procnum: string[2] = 'AA';
recovery: boolean = false;
in_interface: boolean = false;
top_interface: symptr = nil;
globals: symptr = nil;
locals: symptr = nil;
(* nonspecific library includes *)
{$I ljust.inc} {left justify writeln strings}
{$I atoi.inc} {ascii to integer conversion}
{$I itoa.inc} {integer to ascii conversion}
{$I ftoa.inc} {float to ascii conversion}
{$I stoupper.inc} {map string to upper case}
{$I keypress.inc} {msdos versions of keypressed and readkey}
{$I getenv.inc} {get environment variables}
procedure fatal (message: string); forward;
procedure warning (message: string); forward;
procedure scan_tok; forward;
procedure gettok; forward;
procedure puttok; forward;
procedure putline; forward;
procedure puts(s: string); forward;
procedure putln(s: string); forward;
function plvalue: string; forward;
functio